home *** CD-ROM | disk | FTP | other *** search
/ Windows Game Programming for Dummies (2nd Edition) / WinGamProgFD.iso / pc / DirectX SDK / DXSDK / samples / Multimedia / VBSamples / Misc / PowerManagement / dolphin.frm (.txt) next >
Encoding:
Visual Basic Form  |  2001-10-08  |  23.0 KB  |  528 lines
  1. VERSION 5.00
  2. Object = "{1F6AF2BA-798F-4586-8F76-CD0DB05515D9}#1.0#0"; "vb_SubClass.ocx"
  3. Begin VB.Form Form1 
  4.    Caption         =   "Form1"
  5.    ClientHeight    =   4290
  6.    ClientLeft      =   60
  7.    ClientTop       =   345
  8.    ClientWidth     =   5580
  9.    LinkTopic       =   "Form1"
  10.    ScaleHeight     =   286
  11.    ScaleMode       =   3  'Pixel
  12.    ScaleWidth      =   372
  13.    StartUpPosition =   3  'Windows Default
  14.    Begin vbSubClass.SubClasser oSubClass 
  15.       Left            =   120
  16.       Top             =   3720
  17.       _ExtentX        =   873
  18.       _ExtentY        =   873
  19.    End
  20.    Begin VB.PictureBox Picture1 
  21.       Height          =   3615
  22.       Left            =   0
  23.       ScaleHeight     =   3555
  24.       ScaleWidth      =   4635
  25.       TabIndex        =   0
  26.       Top             =   0
  27.       Width           =   4695
  28.    End
  29. Attribute VB_Name = "Form1"
  30. Attribute VB_GlobalNameSpace = False
  31. Attribute VB_Creatable = False
  32. Attribute VB_PredeclaredId = True
  33. Attribute VB_Exposed = False
  34. '-----------------------------------------------------------------------------
  35. ' File: Dolphin.cpp
  36. ' Desc: Sample of swimming dolphin
  37. '       Note: This code uses the D3D Framework helper library.
  38. ' Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
  39. '-----------------------------------------------------------------------------
  40. Option Explicit
  41. '-----------------------------------------------------------------------------
  42. ' Globals variables and definitions
  43. '-----------------------------------------------------------------------------
  44. Private Const WM_POWERBROADCAST = &H218
  45. Private Const PBT_APMQUERYSUSPEND = 0
  46. Private Const PBT_APMRESUMESUSPEND = &H7
  47. Private Const PBT_APMQUERYSTANDBY = &H1
  48. Private Const PBT_APMRESUMESTANDBY = &H8
  49. Private Const PBT_APMBATTERYLOW = &H9
  50. Const WATER_COLOR = &H6688&
  51. Const AMBIENT_COLOR = &H33333333
  52. Const kMesh1 = 0
  53. Const kMesh2 = 1
  54. Const kMesh3 = 2
  55. Private Type DOLPHINVERTEX
  56.     p As D3DVECTOR
  57.     n As D3DVECTOR
  58.     tu As Single
  59.     tv As Single
  60. End Type
  61. Const VertexFVF& = D3DFVF_XYZ Or D3DFVF_NORMAL Or D3DFVF_TEX1
  62. Private Type MESHTOOL
  63.     VertB As Direct3DVertexBuffer8
  64.     NumVertices As Long
  65.     Vertices() As DOLPHINVERTEX
  66. End Type
  67. 'Dolphin objects
  68. Dim m_DolphinGroupObject As CD3DFrame
  69. Dim m_DolphinObject As CD3DFrame
  70. Dim m_DolphinMesh As CD3DMesh
  71. Dim m_DolphinMesh01 As CD3DMesh
  72. Dim m_DolphinMesh02 As CD3DMesh
  73. Dim m_DolphinMesh03 As CD3DMesh
  74. Dim m_DolphinTex As Direct3DTexture8
  75. 'Seafloor objects
  76. Dim m_FloorObject As CD3DFrame
  77. Dim m_SeaFloorMesh As CD3DMesh
  78. Dim m_meshtool(3) As MESHTOOL
  79. Dim m_dest As MESHTOOL
  80. 'Textures for the water caustics
  81. Dim m_CausticTextures() As Direct3DTexture8
  82. Dim m_CurrentCausticTexture As Direct3DTexture8
  83. Dim m_media As String
  84. Dim g_ftime As Single
  85. Dim mfNotSuspended As Boolean
  86. '-----------------------------------------------------------------------------
  87. ' Name: Form_Load()
  88. ' Desc:
  89. '-----------------------------------------------------------------------------
  90. Private Sub Form_Load()
  91.     Me.Show
  92.     DoEvents
  93.     oSubClass.Hook Me.hWnd
  94.     'setup defaults
  95.     Init
  96.     'setup d3d
  97.     D3DUtil_DefaultInitWindowed 0, Picture1.hWnd
  98.     m_media = FindMediaDir("dolphin_group.x")
  99.     D3DUtil_SetMediaPath m_media
  100.     InitDeviceObjects
  101.     RestoreDeviceObjects
  102.     DXUtil_Timer TIMER_START
  103.     mfNotSuspended = True
  104.     Do While mfNotSuspended
  105.         FrameMove
  106.         Render
  107.         D3DUtil_PresentAll 0
  108.         DoEvents
  109.     Loop
  110. End Sub
  111. Private Sub Form_Resize()
  112.     Picture1.width = Me.ScaleWidth
  113.     Picture1.height = Me.ScaleHeight
  114. End Sub
  115. '-----------------------------------------------------------------------------
  116. ' Name: Form_Unload()
  117. ' Desc:
  118. '-----------------------------------------------------------------------------
  119. Private Sub Form_Unload(Cancel As Integer)
  120.     DeleteDeviceObjects
  121.     oSubClass.UnHook
  122.     End
  123. End Sub
  124. Private Sub MESHTOOL_INIT(mt As MESHTOOL, m As D3DXMesh)
  125.     Set mt.VertB = m.GetVertexBuffer
  126.     mt.NumVertices = m.GetNumVertices
  127.     ReDim mt.Vertices(mt.NumVertices)
  128.     D3DVertexBuffer8GetData mt.VertB, 0, mt.NumVertices * Len(mt.Vertices(0)), 0, mt.Vertices(0)
  129. End Sub
  130. Private Sub MESHTOOL_DESTROY(mt As MESHTOOL)
  131.    Set mt.VertB = Nothing
  132.    ReDim mt.Vertices(0)
  133. End Sub
  134. Function FtoDW(f As Single) As Long
  135.     Dim buf As D3DXBuffer
  136.     Dim ret As Long
  137.     Set buf = g_d3dx.CreateBuffer(4)
  138.     g_d3dx.BufferSetData buf, 0, 4, 1, f
  139.     g_d3dx.BufferGetData buf, 0, 4, 1, ret
  140.     Set buf = Nothing
  141.     FtoDW = ret
  142. End Function
  143. '-----------------------------------------------------------------------------
  144. ' Name: Init()
  145. ' Desc: Constructor
  146. '-----------------------------------------------------------------------------
  147. Sub Init()
  148.     Me.Caption = "D3D Dolphin with Power Management Features"
  149.     ReDim m_CausticTextures(32)
  150. End Sub
  151. '-----------------------------------------------------------------------------
  152. ' Name: OneTimeSceneInit()
  153. ' Desc: Called during initial app startup, this function performs all the
  154. '       permanent initialization.
  155. '-----------------------------------------------------------------------------
  156. Sub OneTimeSceneInit()
  157. End Sub
  158. '-----------------------------------------------------------------------------
  159. ' Name: BlendMeshes()
  160. ' Desc: Does a linear interpolation between all vertex positions and normals
  161. '       in two source meshes and outputs the result to the destination mesh.
  162. '       Note: all meshes must contain the same number of vertices, and the
  163. '       destination mesh must be in device memory.
  164. '-----------------------------------------------------------------------------
  165. Sub BlendMeshes(ByVal fWeight As Single)
  166.     Dim fWeight1 As Single, fWeight2 As Single
  167.     Dim vTemp1 As D3DVECTOR, vTemp2 As D3DVECTOR
  168.     Dim i As Long, j As Long
  169.     If (fWeight < 0) Then
  170.         j = kMesh3
  171.     Else
  172.         j = kMesh1
  173.     End If
  174.      
  175.     ' compute blending factors
  176.     fWeight1 = fWeight
  177.     If fWeight < 0 Then fWeight1 = -fWeight1
  178.     fWeight2 = 1 - fWeight1
  179.     ' Linearly Interpolate (LERP)positions and normals
  180.     For i = 0 To m_dest.NumVertices - 1
  181.         D3DXVec3Scale vTemp1, m_meshtool(kMesh2).Vertices(i).p, fWeight2
  182.         D3DXVec3Scale vTemp2, m_meshtool(j).Vertices(i).p, fWeight1
  183.         D3DXVec3Add m_dest.Vertices(i).p, vTemp1, vTemp2
  184.         
  185.         D3DXVec3Scale vTemp1, m_meshtool(kMesh2).Vertices(i).n, fWeight2
  186.         D3DXVec3Scale vTemp2, m_meshtool(j).Vertices(i).n, fWeight1
  187.         D3DXVec3Add m_dest.Vertices(i).n, vTemp1, vTemp2
  188.     Next
  189.     'Set the data
  190.     D3DVertexBuffer8SetData m_dest.VertB, 0, m_dest.NumVertices * Len(m_dest.Vertices(0)), 0, m_dest.Vertices(0)
  191. End Sub
  192. '-----------------------------------------------------------------------------
  193. ' Name: FrameMove()
  194. ' Desc: Called once per frame, the call is the entry point for animating
  195. '       the scene.
  196. '-----------------------------------------------------------------------------
  197. Sub FrameMove()
  198.     g_ftime = DXUtil_Timer(TIMER_GETAPPTIME) * 0.9
  199.     Dim fKickFreq As Single, fPhase As Single, fBlendWeight As Single
  200.     fKickFreq = g_ftime * 2
  201.     fPhase = g_ftime / 3
  202.     fBlendWeight = Sin(fKickFreq)
  203.     ' Blend the meshes (which makes the dolphin appear to swim)
  204.     Call BlendMeshes(fBlendWeight)
  205.     ' Move the dolphin in a circle and have it undulate
  206.     Dim vTrans As D3DVECTOR
  207.     Dim qRot As D3DQUATERNION
  208.     Dim matDolphin As D3DMATRIX
  209.     Dim matTrans As D3DMATRIX, matRotate1 As D3DMATRIX, matRotate2 As D3DMATRIX
  210.     'Scale dolphin geometery to 1/100 original
  211.     D3DXMatrixScaling matDolphin, 0.01, 0.01, 0.01
  212.     'add up and down roation (since modeled along x axis)
  213.     D3DXMatrixRotationZ matRotate1, -Cos(fKickFreq) / 6
  214.     D3DXMatrixMultiply matDolphin, matDolphin, matRotate1
  215.     'add rotation to make dolphin point at tangent to the circle
  216.     D3DXMatrixRotationY matRotate2, fPhase
  217.     D3DXMatrixMultiply matDolphin, matDolphin, matRotate2
  218.     'add traslation to make the dolphin move in a circle and bob up and down
  219.     'in sync with its flippers
  220.     D3DXMatrixTranslation matTrans, -5 * Sin(fPhase), Sin(fKickFreq) / 2, 10 - 10 * Cos(fPhase)
  221.     'D3DXMatrixTranslation matTrans, 0, Sin(fKickFreq) / 2, 0
  222.     D3DXMatrixMultiply matDolphin, matDolphin, matTrans
  223.     m_DolphinObject.SetMatrix matDolphin
  224.     ' Animate the caustic textures
  225.     Dim tex As Long
  226.     tex = CLng((g_ftime * 32)) Mod 32
  227.     Set m_CurrentCausticTexture = m_CausticTextures(tex)
  228. End Sub
  229. '-----------------------------------------------------------------------------
  230. ' Name: Render()
  231. ' Desc: Called once per frame, the call is the entry point for 3d
  232. '       rendering. This function sets up render states, clears the
  233. '       viewport, and renders the scene.
  234. '-----------------------------------------------------------------------------
  235. Sub Render()
  236.     Dim mat As D3DMATRIX
  237.     Dim mat2 As D3DMATRIX
  238.     Dim hr As Long
  239.     hr = g_dev.TestCooperativeLevel()
  240.     If hr = D3DERR_DEVICELOST Then
  241.         
  242.         'If the device is lost, exit and wait for it to come back.
  243.         Exit Sub
  244.     ElseIf hr = D3DERR_DEVICENOTRESET Then
  245.             
  246.         'The device became lost for some reason (probably an alt-tab) and now
  247.         'Reset() needs to be called to try and get the device back.
  248.         g_dev.Reset g_d3dpp
  249.                 
  250.         'Restore Device objects
  251.         RestoreDeviceObjects
  252.         
  253.     End If
  254.     'Make sure the app isn't minimized.
  255.     If Me.WindowState = vbMinimized Then Exit Sub
  256.     ' Clear the backbuffer
  257.     D3DUtil_ClearAll WATER_COLOR
  258.     With g_dev
  259.         .BeginScene
  260.                 
  261.         
  262.         ' Render the Seafloor. For devices that support one-pass multi-
  263.         ' texturing, use the second texture stage to blend in the animated
  264.         ' water caustics texture.
  265.         If (g_d3dcaps.MaxTextureBlendStages > 1) Then
  266.             ' Set up the 2nd texture stage for the animated water caustics
  267.             .SetTexture 1, m_CurrentCausticTexture
  268.             .SetTextureStageState 1, D3DTSS_COLOROP, D3DTOP_MODULATE
  269.             .SetTextureStageState 1, D3DTSS_COLORARG1, D3DTA_TEXTURE
  270.             .SetTextureStageState 1, D3DTSS_COLORARG2, D3DTA_CURRENT
  271.             ' Tell D3D to automatically generate texture coordinates from the
  272.             ' model's position in camera space. The texture transform matrix is
  273.             ' setup so that the 'x' and 'z' coordinates are scaled to become the
  274.             ' resulting 'tu' and 'tv' texture coordinates. The resulting effect
  275.             ' is that the caustic texture is draped over the geometry from above.
  276.             mat.m11 = 0.05:           mat.m12 = 0#
  277.             mat.m21 = 0#:             mat.m22 = 0#
  278.             mat.m31 = 0#:             mat.m32 = 0.05
  279.             mat.m41 = Sin(g_ftime) / 8: mat.m42 = (Cos(g_ftime) / 10) - (g_ftime / 10)
  280.             .SetTransform D3DTS_TEXTURE1, mat
  281.             .SetTextureStageState 1, D3DTSS_TEXCOORDINDEX, D3DTSS_TCI_CAMERASPACEPOSITION
  282.             .SetTextureStageState 1, D3DTSS_TEXTURETRANSFORMFLAGS, D3DTTFF_COUNT2
  283.         End If
  284.         g_dev.SetRenderState D3DRS_AMBIENT, &HB0B0B0B0
  285.         
  286.         
  287.         ' Finally, render the actual seafloor with the above states
  288.         m_FloorObject.Render g_dev
  289.         
  290.         
  291.         ' Disable the second texture stage
  292.         If (g_d3dcaps.MaxTextureBlendStages > 1) Then
  293.             .SetTextureStageState 1, D3DTSS_COLOROP, D3DTOP_DISABLE
  294.         End If
  295.         ' Render the dolphin in it's first pass.
  296.         .SetRenderState D3DRS_AMBIENT, AMBIENT_COLOR
  297.         m_DolphinObject.Render g_dev
  298.         ' For devices that support one-pass multi-texturing, use the second
  299.         ' texture stage to blend in the animated water caustics texture for
  300.         ' the dolphin. This a little tricky because we only want caustics on
  301.         ' the part of the dolphin that is lit from above. To acheive this
  302.         ' effect, the dolphin is rendered alpha-blended with a second pass
  303.         ' which has the caustic effects modulating the diffuse component
  304.         '  which contains lighting-only information) of the geometry.
  305.         If (g_d3dcaps.MaxTextureBlendStages > 1) Then
  306.             ' For the 2nd pass of rendering the dolphin, turn on the caustic
  307.             ' effects. Start with setting up the 2nd texture stage state, which
  308.             ' will modulate the texture with the diffuse component. This actually
  309.             ' only needs one stage, except that using a CD3DFile object makes that
  310.             ' a little tricky.
  311.             .SetTexture 1, m_CurrentCausticTexture
  312.             .SetTextureStageState 1, D3DTSS_COLOROP, D3DTOP_MODULATE
  313.             .SetTextureStageState 1, D3DTSS_COLORARG1, D3DTA_TEXTURE
  314.             .SetTextureStageState 1, D3DTSS_COLORARG2, D3DTA_DIFFUSE
  315.             ' Now, set up D3D to generate texture coodinates. This is the same as
  316.             ' with the seafloor  the 'x' and 'z' position coordinates in camera
  317.             ' space are used to generate the 'tu' and 'tv' texture coordinates),
  318.             ' except our scaling factors are different in the texture matrix, to
  319.             ' get a better looking result.
  320.             mat2.m11 = 0.5: mat2.m12 = 0#
  321.             mat2.m21 = 0#: mat2.m22 = 0#
  322.             mat2.m31 = 0#: mat2.m32 = 0.5
  323.             mat2.m41 = 0#: mat2.m42 = 0#
  324.             .SetTransform D3DTS_TEXTURE1, mat2
  325.             .SetTextureStageState 1, D3DTSS_TEXCOORDINDEX, D3DTSS_TCI_CAMERASPACEPOSITION
  326.             .SetTextureStageState 1, D3DTSS_TEXTURETRANSFORMFLAGS, D3DTTFF_COUNT2
  327.             ' Set the ambient color and fog color to pure black. Ambient is set
  328.             ' to black because we still have a light shining from above, but we
  329.             ' don't want any caustic effects on the dolphin's underbelly. Fog is
  330.             ' set to black because we want the caustic effects to fade out in the
  331.             ' distance just as the model does with the WATER_COLOR.
  332.             .SetRenderState D3DRS_AMBIENT, &H0&
  333.             .SetRenderState D3DRS_FOGCOLOR, &H0&
  334.             ' Set up blending modes to add this caustics-only pass with the
  335.             ' previous pass.
  336.             .SetRenderState D3DRS_ALPHABLENDENABLE, 1 ' True
  337.             .SetRenderState D3DRS_SRCBLEND, D3DBLEND_SRCCOLOR
  338.             .SetRenderState D3DRS_DESTBLEND, D3DBLEND_ONE
  339.             ' Finally, render the caustic effects for the dolphin
  340.             m_DolphinObject.Render g_dev
  341.             ' After all is well and done, restore any munged texture stage states
  342.             .SetTextureStageState 1, D3DTSS_COLOROP, D3DTOP_DISABLE
  343.             .SetRenderState D3DRS_AMBIENT, AMBIENT_COLOR
  344.             .SetRenderState D3DRS_FOGCOLOR, WATER_COLOR
  345.             .SetRenderState D3DRS_ALPHABLENDENABLE, 0 'False
  346.         End If
  347. skipcaustic:
  348.         ' End the scene.
  349.         .EndScene
  350.     End With
  351. End Sub
  352. '-----------------------------------------------------------------------------
  353. ' Name: InitDeviceObjects()
  354. ' Desc: Initialize scene objects.
  355. '-----------------------------------------------------------------------------
  356. Function InitDeviceObjects() As Boolean
  357.     Dim b As Boolean
  358.     Dim t As Long
  359.     Dim strName As String
  360.     Dim i As Long
  361.     'Set up textures for the water caustics
  362.     For t = 0 To 31
  363.         strName = m_media + "Caust" + Format$(t, "00") + ".tga"
  364.         Set m_CausticTextures(t) = D3DUtil_CreateTexture(g_dev, strName, D3DFMT_UNKNOWN)
  365.         If m_CausticTextures(t) Is Nothing Then
  366.             Debug.Print "Unable to find media " + strName
  367.             'End
  368.         End If
  369.     Next
  370.     ' Load the file-based mesh objects
  371.     Set m_DolphinGroupObject = D3DUtil_LoadFromFile(m_media + "dolphin_group.x", Nothing, Nothing)
  372.     Set m_DolphinObject = D3DUtil_LoadFromFile(m_media + "dolphin.x", Nothing, Nothing)
  373.     Set m_FloorObject = D3DUtil_LoadFromFile(m_media + "seafloor.x", Nothing, Nothing)
  374.     ' // Gain access to the meshes
  375.     Set m_DolphinMesh01 = m_DolphinGroupObject.FindChildObject("Dolph01", 0)
  376.     Set m_DolphinMesh02 = m_DolphinGroupObject.FindChildObject("Dolph02", 0)
  377.     Set m_DolphinMesh03 = m_DolphinGroupObject.FindChildObject("Dolph03", 0)
  378.     Set m_DolphinMesh = m_DolphinObject.FindChildObject("Dolph02", 0).GetChildMesh(0)
  379.     Set m_SeaFloorMesh = m_FloorObject.FindChildObject("SeaFloor", 0)
  380.     ' Set the FVF type to something useful
  381.     Call m_DolphinMesh01.SetFVF(g_dev, VertexFVF)
  382.     Call m_DolphinMesh02.SetFVF(g_dev, VertexFVF)
  383.     Call m_DolphinMesh03.SetFVF(g_dev, VertexFVF)
  384.     Call m_DolphinMesh.SetFVF(g_dev, VertexFVF)
  385.     Call m_SeaFloorMesh.SetFVF(g_dev, VertexFVF)
  386.     Set m_DolphinTex = D3DUtil_CreateTexture(g_dev, m_media + "dolphin.bmp", D3DFMT_UNKNOWN)
  387.     ' Scale the sea floor vertices, and add some bumpiness
  388.     Dim seafloortool As MESHTOOL
  389.     MESHTOOL_INIT seafloortool, m_SeaFloorMesh.mesh
  390.     For i = 0 To seafloortool.NumVertices - 1
  391.        seafloortool.Vertices(i).p.y = seafloortool.Vertices(i).p.y + Rnd(1) + Rnd(1) + Rnd(1)
  392.        seafloortool.Vertices(i).tu = seafloortool.Vertices(i).tu * 10
  393.        seafloortool.Vertices(i).tv = seafloortool.Vertices(i).tv * 10
  394.     Next
  395.     D3DVertexBuffer8SetData seafloortool.VertB, 0, Len(seafloortool.Vertices(0)) * seafloortool.NumVertices, 0, seafloortool.Vertices(0)
  396.     MESHTOOL_DESTROY seafloortool
  397.     MESHTOOL_INIT m_meshtool(kMesh1), m_DolphinMesh01.mesh
  398.     MESHTOOL_INIT m_meshtool(kMesh2), m_DolphinMesh02.mesh
  399.     MESHTOOL_INIT m_meshtool(kMesh3), m_DolphinMesh03.mesh
  400.     MESHTOOL_INIT m_dest, m_DolphinMesh.mesh
  401.     InitDeviceObjects = True
  402.         
  403. End Function
  404. '-----------------------------------------------------------------------------
  405. ' Name: RestoreDeviceObjects()
  406. ' Desc: Restore device-memory objects and state after a device is created or
  407. '       resized.
  408. '-----------------------------------------------------------------------------
  409. Sub RestoreDeviceObjects()
  410.     m_DolphinGroupObject.RestoreDeviceObjects g_dev
  411.     m_DolphinObject.RestoreDeviceObjects g_dev
  412.     m_FloorObject.RestoreDeviceObjects g_dev
  413.     ' Set miscellaneous render states
  414.     With g_dev
  415.         
  416.         ' Set world transform
  417.         Dim matWorld As D3DMATRIX
  418.         D3DXMatrixIdentity matWorld
  419.         .SetTransform D3DTS_WORLD, matWorld
  420.        ' Set the app view matrix for normal viewing
  421.         Dim vEyePt As D3DVECTOR, vLookatPt As D3DVECTOR, vUpVec As D3DVECTOR
  422.         Dim matView As D3DMATRIX
  423.         vEyePt = vec3(0, 0, -5)
  424.         vLookatPt = vec3(0, 0, 0)
  425.         vUpVec = vec3(0, 1, 0)
  426.         D3DXMatrixLookAtLH matView, vEyePt, vLookatPt, vUpVec
  427.         .SetTransform D3DTS_VIEW, matView
  428.         
  429.         ' Set the projection matrix
  430.         Dim matProj As D3DMATRIX
  431.         Dim fAspect As Single
  432.         fAspect = 1
  433.         D3DXMatrixPerspectiveFovLH matProj, g_pi / 3, fAspect, 1, 10000
  434.         .SetTransform D3DTS_PROJECTION, matProj
  435.         
  436.         .SetTextureStageState 0, D3DTSS_COLORARG1, D3DTA_TEXTURE
  437.         .SetTextureStageState 0, D3DTSS_COLORARG2, D3DTA_DIFFUSE
  438.         .SetTextureStageState 0, D3DTSS_COLOROP, D3DTOP_MODULATE
  439.         .SetTextureStageState 0, D3DTSS_MINFILTER, D3DTEXF_LINEAR
  440.         .SetTextureStageState 0, D3DTSS_MAGFILTER, D3DTEXF_LINEAR
  441.         .SetTextureStageState 1, D3DTSS_MINFILTER, D3DTEXF_LINEAR
  442.         .SetTextureStageState 1, D3DTSS_MAGFILTER, D3DTEXF_LINEAR
  443.         ' Set default render states
  444.         .SetRenderState D3DRS_DITHERENABLE, 1 'True
  445.         .SetRenderState D3DRS_SPECULARENABLE, 0 'False
  446.         .SetRenderState D3DRS_ZENABLE, 1 'True
  447.         .SetRenderState D3DRS_NORMALIZENORMALS, 1 'True
  448.         ' Turn on fog, for underwater effect
  449.         Dim fFogStart  As Single
  450.         Dim fFogEnd As Single
  451.         fFogStart = 1
  452.         fFogEnd = 50
  453.         .SetRenderState D3DRS_FOGENABLE, 1 ' True
  454.         .SetRenderState D3DRS_FOGCOLOR, WATER_COLOR
  455.         .SetRenderState D3DRS_FOGTABLEMODE, D3DFOG_NONE
  456.         .SetRenderState D3DRS_FOGVERTEXMODE, D3DFOG_LINEAR
  457.         .SetRenderState D3DRS_RANGEFOGENABLE, 0 'False
  458.         .SetRenderState D3DRS_FOGSTART, FtoDW(fFogStart)
  459.         .SetRenderState D3DRS_FOGEND, FtoDW(fFogEnd)
  460.             
  461.         ' Create a directional light
  462.         Dim light As D3DLIGHT8
  463.         D3DUtil_InitLight light, D3DLIGHT_DIRECTIONAL, 0, -1, 0
  464.         .SetLight 0, light
  465.         .LightEnable 0, 1 'True
  466.         .SetRenderState D3DRS_LIGHTING, 1 'TRUE
  467.         .SetRenderState D3DRS_AMBIENT, AMBIENT_COLOR
  468.     End With
  469. End Sub
  470. '-----------------------------------------------------------------------------
  471. ' Name: InvalidateDeviceObjects()
  472. ' Desc: Called when the device-dependant objects are about to be lost.
  473. '-----------------------------------------------------------------------------
  474. Sub InvalidateDeviceObjects()
  475.     m_FloorObject.InvalidateDeviceObjects
  476.     m_DolphinGroupObject.InvalidateDeviceObjects
  477.     m_DolphinObject.InvalidateDeviceObjects
  478. End Sub
  479. '-----------------------------------------------------------------------------
  480. ' Name: DeleteDeviceObjects()
  481. ' Desc: Called when the app is exitting, or the device is being changed,
  482. '       this function deletes any device dependant objects.
  483. '----------------------------------------------------------------------
  484. Sub DeleteDeviceObjects()
  485.     m_FloorObject.Destroy
  486.     m_DolphinGroupObject.Destroy
  487.     m_DolphinObject.Destroy
  488.     MESHTOOL_DESTROY m_meshtool(0)
  489.     MESHTOOL_DESTROY m_meshtool(1)
  490.     MESHTOOL_DESTROY m_meshtool(2)
  491.     MESHTOOL_DESTROY m_dest
  492.     Set m_DolphinGroupObject = Nothing
  493.     Set m_DolphinObject = Nothing
  494.     Set m_DolphinMesh = Nothing
  495.     Set m_DolphinMesh01 = Nothing
  496.     Set m_DolphinMesh02 = Nothing
  497.     Set m_DolphinMesh03 = Nothing
  498.     Set m_FloorObject = Nothing
  499.     Set m_SeaFloorMesh = Nothing
  500. End Sub
  501. Private Sub oSubClass_WindowsMessage(ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long)
  502.     Select Case uMsg
  503.     Case WM_POWERBROADCAST 'Something is happening
  504.         Select Case wParam
  505.         Case PBT_APMQUERYSUSPEND, PBT_APMBATTERYLOW, PBT_APMQUERYSTANDBY
  506.             'We're going into Standby mode, or suspend mode, we need to pause the sample
  507.             mfNotSuspended = False 'Stop the render loop
  508.             DeleteDeviceObjects 'Delete everything
  509.             
  510.         Case PBT_APMRESUMESUSPEND, PBT_APMRESUMESTANDBY
  511.             'We're returning, go ahead and restart the sample
  512.             'setup defaults
  513.             Init
  514.             
  515.             'setup d3d
  516.             D3DUtil_DefaultInitWindowed 0, Picture1.hWnd
  517.             m_media = FindMediaDir("dolphin_group.x")
  518.             D3DUtil_SetMediaPath m_media
  519.             
  520.             InitDeviceObjects
  521.             RestoreDeviceObjects
  522.             
  523.             DXUtil_Timer TIMER_START
  524.             mfNotSuspended = True
  525.         End Select
  526.     End Select
  527. End Sub
  528.